home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / datawiz / moddfd.bas < prev   
Encoding:
BASIC Source File  |  1996-04-08  |  6.1 KB  |  141 lines
  1. Attribute VB_Name = "modDFD"
  2. Global gobjIDEAppInst As Object
  3. #If Win16 Then
  4.     Declare Function OSWritePrivateProfileString% Lib "KERNEL" Alias "WritePrivateProfileString" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
  5.     Declare Function OSGetPrivateProfileString% Lib "KERNEL" Alias "GetPrivateProfileString" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal ReturnString$, ByVal NumBytes As Integer, ByVal FileName$)
  6. #Else
  7.     Declare Function OSWritePrivateProfileString% Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal FileName$)
  8.     Declare Function OSGetPrivateProfileString% Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal AppName$, ByVal KeyName$, ByVal keydefault$, ByVal ReturnString$, ByVal NumBytes As Integer, ByVal FileName$)
  9. #End If
  10.  
  11. '--------------------------------------------------------------------------
  12. 'this is the startup point for the server
  13. 'it will add the entry to VB.INI if it doesn't already exist
  14. 'so that the add-in is on available next time VB is loaded
  15. '--------------------------------------------------------------------------
  16. Sub Main()
  17.   Dim ReturnString As String
  18.   '--- Check to see if we are in the VB.INI File.  If not, Add ourselves to the INI file
  19.   #If Win16 Then
  20.     Section$ = "Add-Ins16"
  21.   #Else
  22.     Section$ = "Add-Ins32"
  23.   #End If
  24.   ReturnString = String$(12, Chr$(0))
  25.   ErrCode = OSGetPrivateProfileString(Section$, "DataFormWizard.DFWizardClass", "NotFound", ReturnString, Len(ReturnString) + 1, "VB.INI")
  26.   If Left(ReturnString, ErrCode) = "NotFound" Then
  27.     ErrCode = OSWritePrivateProfileString%(Section$, "DataFormWizard.DFWizardClass", "0", "VB.INI")
  28.   End If
  29. End Sub
  30.  
  31. '--------------------------------------------------------------------------
  32. 'this function strips the file name off of a path/filename
  33. 'for use with ISAM databases that need the directory only
  34. '--------------------------------------------------------------------------
  35. Function StripFileName(rsFileName As String) As String
  36.   On Error Resume Next
  37.   Dim i As Integer
  38.  
  39.   For i = Len(rsFileName) To 1 Step -1
  40.     If Mid(rsFileName, i, 1) = "\" Then
  41.       Exit For
  42.     End If
  43.   Next
  44.   StripFileName = Mid(rsFileName, 1, i - 1)
  45. End Function
  46.  
  47. '--------------------------------------------------------------------------
  48. 'this sub writes out the code that will be added to the VB project
  49. 'this is where you would add more code if you would like to
  50. 'add to the basic template provided here
  51. '--------------------------------------------------------------------------
  52. Sub WriteFrmCode(fh As Integer)
  53.   On Error GoTo WCErr
  54.   
  55.   Dim i As Integer
  56.   
  57.   If frmDFD.iScreenStyle <> 2 Then
  58.     Print #fh, "Private Sub cmdAdd_Click()"
  59.     Print #fh, "  Data1.Recordset.AddNew"
  60.     Print #fh, "End Sub"
  61.     Print #fh, ""
  62.     
  63.     Print #fh, "Private Sub cmdDelete_Click()"
  64.     Print #fh, "  'this may produce an error if you delete the last"
  65.     Print #fh, "  'record or the only record in the recordset"
  66.     Print #fh, "  Data1.Recordset.Delete"
  67.     Print #fh, "  Data1.Recordset.MoveNext"
  68.     Print #fh, "End Sub"
  69.     Print #fh, ""
  70.     Print #fh, "Private Sub cmdRefresh_Click()"
  71.     Print #fh, "  'this is really only needed for multi user apps"
  72.     Print #fh, "  Data1.Refresh"
  73.     Print #fh, "End Sub"
  74.     Print #fh, ""
  75.     Print #fh, "Private Sub cmdUpdate_Click()"
  76.     Print #fh, "  Data1.UpdateRecord"
  77.     Print #fh, "  Data1.Recordset.Bookmark = Data1.Recordset.LastModified"
  78.     Print #fh, "End Sub"
  79.     Print #fh, ""
  80. End If
  81.   Print #fh, "Private Sub cmdClose_Click()"
  82.   Print #fh, "  Unload Me"
  83.   Print #fh, "End Sub"
  84.   Print #fh, ""
  85.   Print #fh, "Private Sub Data1_Error(DataErr As Integer, Response As Integer)"
  86.   Print #fh, "  'This is where you would put error handling code"
  87.   Print #fh, "  'If you want to ignore errors, comment out the next line"
  88.   Print #fh, "  'If you want to trap them, add code here to handle them"
  89.   Print #fh, "  MsgBox ""Data error event hit err:"" & Error$(DataErr)"
  90.   Print #fh, "  Response = 0  'throw away the error"
  91.   Print #fh, "End Sub"
  92.   Print #fh, ""
  93.   Print #fh, "Private Sub Data1_Reposition()"
  94.   Print #fh, "  Screen.MousePointer = vbDefault"
  95.   Print #fh, "  On Error Resume Next"
  96.   Print #fh, "  'This will display the current record position"
  97.   Print #fh, "  'for dynasets and snapshots"
  98.   Print #fh, "  Data1.Caption = ""Record: "" & (Data1.Recordset.AbsolutePosition + 1)"
  99.   Print #fh, "  'for the table object you must set the index property when"
  100.   Print #fh, "  'the recordset gets created and use the following line"
  101.   Print #fh, "  'Data1.Caption = ""Record: "" & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1"
  102.   Print #fh, "End Sub"
  103.   Print #fh, ""
  104.   Print #fh, "Private Sub Data1_Validate(Action As Integer, Save As Integer)"
  105.   Print #fh, "  'This is where you put validation code"
  106.   Print #fh, "  'This event gets called when the following actions occur"
  107.   Print #fh, "  Select Case Action"
  108.   Print #fh, "    Case vbDataActionMoveFirst"
  109.   Print #fh, "    Case vbDataActionMovePrevious"
  110.   Print #fh, "    Case vbDataActionMoveNext"
  111.   Print #fh, "    Case vbDataActionMoveLast"
  112.   Print #fh, "    Case vbDataActionAddNew"
  113.   Print #fh, "    Case vbDataActionUpdate"
  114.   Print #fh, "    Case vbDataActionDelete"
  115.   Print #fh, "    Case vbDataActionFind"
  116.   Print #fh, "    Case vbDataActionBookMark"
  117.   Print #fh, "    Case vbDataActionClose"
  118.   Print #fh, "  End Select"
  119.   Print #fh, "  Screen.MousePointer = vbHourglass"
  120.   Print #fh, "End Sub"
  121.   Print #fh, ""
  122.   
  123.   'write the code for the bound OLE client control(s)
  124.   For i = 0 To frmDFD.lstOLECtls.ListCount - 1
  125.     Print #fh, "Private Sub oleField" & frmDFD.lstOLECtls.List(i) & "_DblClick()"
  126.     Print #fh, "  'this is the way to get data into an empty ole control"
  127.     Print #fh, "  'and have it saved back to the table"
  128.     Print #fh, "  oleField" & frmDFD.lstOLECtls.List(i) & ".InsertObjDlg"
  129.     Print #fh, "End Sub"
  130.     Print #fh, ""
  131.   Next
  132.   
  133.   Exit Sub
  134.   
  135. WCErr:
  136.   MsgBox Err.Description & " Occurred in writing form code."
  137.   
  138.   Exit Sub
  139.   
  140. End Sub
  141.